perm filename PPCODE.SAI[PNT,HE]3 blob sn#466135 filedate 1979-08-13 generic text, type C, neo UTF8
COMMENT ⊗   VALID 00002 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	ENTRY
C00007 ENDMK
C⊗;
ENTRY;
BEGIN "PPCODE"
DEFINE $$PRGID=TRUE, $PPCODE=TRUE;
REQUIRE "HEADER.SAI" SOURCE_FILE;

REQUIRE "[][]" DELIMITERS;
REDEFINE MAKEOP(OPNUM,OPNAM,OPVAL)"[]" = [,"OPNAM"];
PRESET_WITH "not valid" INTOPS;
STRING ARRAY SPCODE[0:#ALINTOPS/2];

SIMPLE STRING PROCEDURE SCODE(INTEGER I);
	IF I MOD 2 = 0 AND 0≤I≤#ALINTOPS THEN RETURN(SPCODE[I/2])
		ELSE RETURN(SPCODE[0]);

INTERNAL PROCEDURE PPCODE(RPTR(EXPR$)EE;INTEGER SNUM(1));
BEGIN
	! program to print out pcode from number form to pcode form;
	INTEGER INDEX,INDEXF;

	PROCEDURE RPRINT;
	BEGIN
		PRINT("	",RFVAL(EXPR$:BODY[EE][INDEX+1],
				EXPR$:BODY[EE][INDEX+2]));
		INDEX←INDEX+2;
	END;

!	PROCEDURE LPRINT;
!		PRINT("	.+ ",EXPR$:BODY[EE][INDEX←INDEX+1]-GRINCH2);

	PROCEDURE OPRINT;
		PRINT("	",CVOS(EXPR$:BODY[EE][INDEX←INDEX+1]));

	PROCEDURE RDPRINT;
		PRINT("	.+ ",EXPR$:BODY[EE][INDEX←INDEX+1],"(D)");

	PROCEDURE DPRINT;
		PRINT("	",EXPR$:BODY[EE][INDEX←INDEX+1],"(D)");

	PROCEDURE NLPRINT;
		PRINT(CRLF,INDEX+1,":	");
	PROCEDURE NPCODE;
	BEGIN
		INTEGER I,J;
		NLPRINT;		! start new line;
		I←EXPR$:BODY[EE][INDEX←INDEX+1]/2;
		J←EXPR$:BODY[EE][INDEX] MOD 2;
		IF J=0 AND 1≤I≤ARRINFO(SPCODE,2)
			THEN PRINT(SPCODE[I])
			ELSE PRINT(EXPR$:BODY[EE][INDEX],"(D)");
		IF J=0 THEN
		CASE I OF
		BEGIN
		    [XJUMP/2][XPRINT/2][XJUMPC/2][XFORCHK/2]
			RDPRINT;
		    [XRJMP/2][XRPRINT/2][XRJMPC/2][XRFRCHK/2]
			RDPRINT;
		    [XPUSHSCI/2]
			RPRINT;
		    [XAFFIX/2]
			BEGIN
			OPRINT;	OPRINT;	OPRINT;
			IF EXPR$:BODY[EE][INDEX] LAND '2000 THEN OPRINT;
			END;
		    [XAGTVAL/2][XACHNGE/2][XARTVAL/2]
			BEGIN OPRINT; OPRINT; END;
		    [XGTVAL/2][XCHNGE/2][XWHERE/2][XPUSHINTI/2][XKVAR/2]
		    [XGTBLK/2][XCOPY/2][XRETURN/2][XPROC/2][XREPLAC/2]
		    [XGATHER/2][XCHCMP][XCHTPOS][XCHTORIENT]
			OPRINT;
		    [XRCENTER/2][XRPMOVE/2]
		    [XRTADRIVE/2][XRTDDRIVE/2]
			BEGIN RDPRINT; OPRINT; END;
		    [XMVAR/2]
			DO OPRINT UNTIL 
				EXPR$:BODY[EE][INDEX]=0;
		    [XAPUSHOFFSET/2]
			BEGIN OPRINT;OPRINT END;
		    [XPUSHOFFSET/2]
			OPRINT;
		    [XGTINT/2][XGVALS/2][XCHNGS/2]
		    [XPUNFIX/2] INDEX←INDEX;
		    [XPAFFIX/2] OPRINT;
		    [XPSPROUT/2]
			BEGIN INTEGER I,N;
			    DPRINT;
			    N←EXPR$:BODY[EE][INDEX];
			    FOR I←1 STEP 1 UNTIL N DO
				BEGIN NLPRINT; RDPRINT;OPRINT; END;
			    NLPRINT; OPRINT;
			END;
		    ELSE INDEX←INDEX
		END;
		
	END;
	INDEX←SNUM-1;INDEXF←EXPR$:#BODY[EE];
	WHILE INDEX<INDEXF DO NPCODE;
	NLPRINT; PRINT(CRLF);
END;

PROCEDURE PPPCODE;ppcode(null_record);
END;